(defpackage :linearize-demo
  (:use :cl)
  (:nicknames :ld)
  (:export :generate))

(in-package :linearize-demo)

(defun generate (problem instruction-condition computation-condition prop-down prop-up linearize)
  (let ((tree (sf:equation-to-tree problem))
        ;;(view (make-instance 'smart-tree:smart-tree-view :width 500 :height 500))
        last
        states)
    (labels ((maybe-highlight (tree kp)
               (let ((copy (tree:copy-node tree t)))
                 (when kp
                   (setf (d:highlighted (d:find-node-by-id copy (d:id kp))) t))
                 copy))
             (uncommandify (message)
               (setf message (ppcre:regex-replace "Click a" message "You can click a"))
               (setf message (ppcre:regex-replace "Enter a" message "You can enter a"))
               (setf message (ppcre:regex-replace " Click it." message ""))
               (setf message (ppcre:regex-replace " Enter it." message ""))
               (setf message (ppcre:regex-replace "Copy the number below" message "The number below goes"))
               (setf message (ppcre:regex-replace "Move the mouse to this tile and enter" message "The answer to this box is"))
               (setf message (ppcre:regex-replace " Enter (-?[0-9]+\\.)" message " So, the answer is \\1"))
               message)
             (save-state (&key current last-state faded popup keypad-node popup-keypad-node message overlay-nodes overlay-next-node)
               (push
                (demo:make-state :class 'lv:linear-view
                                 :current (maybe-highlight current keypad-node)
                                 :faded faded
                                 :last (when (or last-state last) (tree:copy-node (or last-state last) t))
                                 :keypad (when keypad-node (d:id keypad-node))
                                 :popup-keypad (when popup-keypad-node (d:id popup-keypad-node))
                                 :popup (when popup
                                          (maybe-highlight popup popup-keypad-node))
                                 :message (uncommandify message)
                                 :overlay-nodes (when overlay-nodes (mapcar 'd:id overlay-nodes))
                                 :overlay-next-node overlay-next-node)
                states))
             (collapse (n &rest keys &key &allow-other-keys)
               (setf (d:quantity n) (u:string2 (d:answer n)))
               (apply #'save-state keys)
               (assert (d:valid-input-p n (d:quantity n)))
               (o:collapse-input-argument n))
             (hint (arg)
               (if (typep (d:hint arg) 'lt::hint)
                   (lt::hint-text (d:hint arg))
                   (d:hint arg)))
             (do-inputs ()
               (let ((nodes (d:collect-on-tree (lambda (n) (typep n 'd:input-argument)) tree)))
                 ;; (setf (d:arrow (first nodes)) t)
                 ;; (save-state tree rep nil nil (d:hint (first nodes)))
                 (dolist (n nodes)
                   (let ((hint (d:hint n)))
                     (d:clear-arrows tree)
                     (setf (d:arrow n) t)
                     ;; (when (and (typep hint 'lt::hint)
                     ;;            (eq instr-condition :instruction))
                     ;;   (ecase (lt::hint-which (d:hint n))
                     ;;     (:unknown (linearize::fill-unknown-nodes-with-help last hint))
                     ;;     (:constant (linearize::fill-constant-nodes-with-help last hint))))
                     (save-state :current tree :keypad-node n :message hint)
                     (collapse n :current tree :keypad-node n :message hint)))
                 (d:clear-arrows tree)))
             (fill-in-representation (root rep-root)
               (save-state :current root :popup rep-root :message "We want you to rewrite the part of the tree that you are linearizing into an equation form to help you see how to do it.")
               (let ((inputs (d:collect-on-tree (constantly t)
                                                rep-root
                                                :only-type 'd:input-argument
                                                :from-end t)))
                 (dolist (n inputs)
                   (let ((other (d:find-node-by-id last (d:id n))))
                     (when other
                       (setf (d:arrow other) t)))
                   (setf (d:highlighted n) t)
                   (save-state :current root :popup rep-root :popup-keypad-node n)
                   (collapse n :current root :popup rep-root :popup-keypad-node n)
                   (d:clear-highlights rep-root)
                   (d:clear-arrows last)
                   (save-state :current root :popup rep-root))))
             (animate-greens (last-root bottom)
               "Return a list of trees each with one more green box than the last."
               (let* ((greens-left (butlast (d:collect-on-tree (constantly t) (d:box-left-arg bottom) :only-type 'cuhelp-mixin::green-box)))
                      (greens-right (butlast (d:collect-on-tree (constantly t) (d:box-right-arg bottom) :only-type 'cuhelp-mixin::green-box)))
                      (greens (append greens-right greens-left)))
                 (nreverse
                  (loop for g in greens
                     collect (list (tree:copy-node last-root t)
                                   (let* ((box (tree:child g))
                                          (op (d:quantity (d:box-operator-arg box))))
                                     (ecase instruction-condition
                                       (:instruction
                                        (etypecase g
                                          (chm::combo-green-box
                                           (ecase op
                                             ((+ -) (format nil "~a flows into the box below." (d:quantity g)))
                                             (* (format nil "The product of ~a and X flows into the box below." (chm::unknown-value g)))))
                                          (chm::unknown-green-box
                                           (ecase op
                                             (+ "The sign of the X is maintained when it flows into the box below.")
                                             (- (if (eq g (d:box-left-arg box))
                                                    "The sign of the X is maintained when it flows into the box below."
                                                    "The sign of the X is changed when it flows into the box below."))
                                             (* (format nil "The product of ~a and ~a flows into the box below."
                                                        (d:quantity (d:box-left-arg box))
                                                        (d:quantity (d:box-right-arg box))))))
                                          (chm::constant-green-box
                                           (format nil "The ~a of ~a and ~a flows into the box below."
                                                   (ecase op
                                                     (+ "sum")
                                                     (- "difference")
                                                     (* "product"))
                                                   (d:quantity (d:box-left-arg box))
                                                   (d:quantity (d:box-right-arg box))))))
                                       (:discovery
                                        (etypecase g
                                          (chm::combo-green-box "This illustrates how to fill in the blue tiles.")
                                          (chm::unknown-green-box "This illustrates how to fill in the blue tiles.")
                                          (chm::constant-green-box "This illustrates how to fill in the blue tiles.")))
                                       (:expression (warn "TODO")))))
                     do (change-class g 'd:argument)
                     do (setf (d:quantity g) nil
                              (d:background g) (gwee:gray 240))))))
             (fill-node-for-rep (new-tree rep n help)
               (save-state :current new-tree :popup rep :keypad-node n :message help)
               (collapse n :current new-tree :popup rep :keypad-node n :message help)
               (d:clear-arrows new-tree)
               (save-state :current new-tree :popup rep))
             (do-linearize-input-rep (tree new-tree)
               (let* ((help "Enter a number.")
                      (inputs (nreverse (d:collect-on-tree (constantly t)
                                                              new-tree
                                                              :only-type 'd:input-argument)))
                      (unknown-op (d:box-operator-arg (tree:parent (first inputs))))
                      (constant-op (d:box-operator-arg (tree:parent (second inputs))))
                      (rep (rm::make-equation tree (first inputs) (second inputs))))
                 (fill-in-representation new-tree rep)
                 ;; unknown
                 (chm::green-boxify-unknown-other (first inputs))
                 (save-state :current new-tree :popup rep)
                 (setf (d:background unknown-op) (gwee:color 0 255 0))
                 (d:point-to-nodes new-tree (first inputs))
                 (save-state :current new-tree :popup rep :message help)
                 (fill-node-for-rep new-tree rep (first inputs) help)
                 ;; constant
                 (chm::green-boxify-unknown-parent (first inputs))
                 (save-state :current new-tree :popup rep)
                 (setf (d:background unknown-op) (gwee:gray 240))
                 (setf (d:background constant-op) (gwee:color 0 255 0))
                 (d:clear-arrows new-tree)
                 (d:point-to-nodes new-tree (second inputs))
                 (save-state :current new-tree :popup rep :message help)
                 (fill-node-for-rep new-tree rep (second inputs) help)
                 (setf (d:background constant-op) (gwee:gray 240))))
             (fill-in-linearize-input (tree last-state input type help)
               (let ((op (d:box-operator-arg (tree:parent input))))
                 (setf (d:arrow input) t
                       (d:background op) (gwee:color 0 255 0)))
               (when (eq type :unknown)
                 (chm::green-boxify-unknown-other input)
                 (save-state :current tree :last-state last-state :message help))
               (save-state :current tree :last-state last-state :keypad-node input :message help)
               (collapse input :current tree :last-state last-state :keypad-node input :message help)
               (save-state :current tree :last-state last-state :message help)
               (when (eq type :unknown)
                 (chm::green-boxify-unknown-parent input)
                 (save-state :current tree :last-state last-state))
               (setf (d:arrow input) nil
                     (d:background (d:box-operator-arg (tree:parent input))) (gwee:gray 240)))
             (add-initial-overlay (new-tree copy input type)
               (multiple-value-bind (bottom cv uv bottom-cvs bottom-uvs hint eqn)
                   (chm::add-last-state-overlay-helper copy input
                                                       :bothp (ecase computation-condition
                                                                (:both t)
                                                                (:split nil))
                                                       :only-top-args-p t)
                 (declare (ignore cv uv bottom bottom-uvs bottom-cvs eqn hint))
                 (save-state :current new-tree :last-state copy
                             :message (ecase type
                                        (:unknown
                                         (ecase instruction-condition
                                           (:instruction "This illustrates how to fill in the blue tiles. Imagine X's propagating down the left and right branches of the top box.")
                                           (:discovery "This illustrates how to fill in the blue tiles.")))
                                        (:constant
                                         (ecase instruction-condition
                                           (:instruction "Calculate the constant added to the input into this box by imagining 0's propagating down from the top box. By propagating 0 down, only constants are added without X in the computation.")
                                           (:discovery "This illustrates how to fill in the blue tiles.")))))
                 (chm::clear-green-tiles copy)))
             (do-linearize-input (tree new-tree type skip-animation)
               (let* ((copy (tree:copy-node tree t))
                      (input (d:find-if-on-tree (lambda (n)
                                                  (let ((op (d:quantity (d:box-operator-arg (tree:parent n)))))
                                                    (ecase type
                                                      (:unknown (eq op '*))
                                                      (:constant (eq op '+)))))
                                                new-tree
                                                :only-type 'd:input-argument)))
                 (assert input)
                 (unless skip-animation
                   (add-initial-overlay new-tree copy input type))
                 (multiple-value-bind (bottom cv uv bottom-cvs bottom-uvs hint eqn)
                     (chm::add-last-state-overlay-helper copy input :bothp (ecase computation-condition
                                                                             (:both t)
                                                                             (:split nil)))
                   (declare (ignore eqn))
                   (let ((popup (tree:copy-node copy t))
                         (animation (animate-greens copy bottom))
                         (help (chm::green-box-enter-help hint cv uv bottom-cvs bottom-uvs instruction-condition)))
                     (unless skip-animation
                       (dolist (a animation)
                         (save-state :current new-tree :last-state (first a) :message (second a))))
                     (fill-in-linearize-input new-tree popup input type help)))))
             (linearize ()
               (multiple-value-bind (root trans vars selections-needed)
                   (o:find-transformation-for tree (o:transformations linearize) t)
                 (declare (ignore trans vars))
                 (when root
                   (let ((hint1 (ecase instruction-condition
                                  (:instruction
                                   (format nil "~d cannot be propagated up because the box above it has two little tiles resulting in two paths leading back to the unknown. You can eliminate this loop. You start by clicking the box at the bottom of the loop." (d:quantity (tree:parent root))))
                                  (:discovery
                                   "You should click a set of boxes in a pattern highlighted by a green line.")))
                         (hint2 (ecase instruction-condition
                                  (:instruction
                                   "All the boxes on the loop need to be selected. You can select a box on the loop that has a single empty tile.")
                                  (:discovery
                                   "You should click a set of boxes in a pattern highlighted by a green line.")))
                         (hint3 (ecase instruction-condition
                                  (:instruction
                                   "Now that all the boxes in the loop have been selected, you can click the Linearize button (not shown) to convert this loop into a linear structure.")
                                  (:discovery
                                   "Now you can click the Linearize button (not shown).")))
                         (bottom (lt:find-bottom-box tree selections-needed)))
                     (save-state :current tree :message hint1 :overlay-nodes selections-needed :overlay-next-node bottom)
                     (setf (d:selected bottom) t)
                     (save-state :current tree :message hint2 :overlay-nodes selections-needed :overlay-next-node (first (remove bottom selections-needed)))
                     (loop for r on (remove bottom selections-needed)
                        for s = (car r)
                        do (setf (d:selected s) t)
                        (save-state :current tree :message (if (cdr r) hint2 hint3) :overlay-nodes selections-needed :overlay-next-node (second r))))
                   (setf last (tree:copy-node tree t))
                   (let* ((copy (tree:copy-node tree t))
                          (new-tree (o:perform-operation copy linearize)))
                     (save-state :current new-tree :message (ecase instruction-condition
                                                              (:instruction
                                                               "The diagram has been transformed to a linear form of X. The top blue tile is the number of X's remaining and the bottom blue tile is the constant added to X.")
                                                              (:discovery "The diagram has been transformed.")))
                     (assert new-tree)
                     (do-linearize-input tree new-tree :unknown nil)
                     (do-linearize-input tree new-tree :constant (ecase computation-condition
                                                                   (:both t)
                                                                   (:split nil)))
                     (setf tree new-tree)
                     (chm::clear-green-tiles tree))
                     t)))
             (propogate (op type)
               (multiple-value-bind (match trans vars selections-needed)
                   (o:find-transformation-for tree (o:transformations op) t)
                 (declare (ignore trans vars))
                 (when match
                   (dolist (s selections-needed)
                     (setf (d:arrow s) t))
                   (save-state :current tree :message (ecase instruction-condition
                                                        (:instruction
                                                         (ecase type
                                                           (:down "You can calculate the value of this tile from the value above. Click it.")
                                                           (:up (if (> (length (tree:children (tree:parent (first selections-needed)))) 1)
                                                                    "You can calculate the value for this tile from the value in it and the value below."
                                                                    "You can calculate the value of this tile from the value below. Click it."))))
                                                        (:discovery
                                                         "Click a tile.")))
                   (dolist (s selections-needed)
                     (setf (d:selected s) t))
                   (let ((new-tree (o:perform-operation tree op)))
                     (assert new-tree)
                     (setf tree new-tree))
                   (do-inputs)
                   t))))
      (loop while (or (propogate prop-down :down)
                      (propogate prop-up :up)
                      (linearize))
           do (length states))
      (save-state :current tree :message "")
      ;; (loop while 
      (nreverse states))))

;; (defun doeet (problem)
;;   (generate problem
;;             :discovery
;;             (make-instance 'o:operation :name :evaluate
;;                            :transformations (nd::nd-evaluate-transformations :minimum))
;;             (make-instance 'o:operation :name :evaluate
;;                            :transformations (nd::nd-invert-transformations :minimum))
;;             (make-instance 'o:operation :name :linerize
;;                            :transformations (list (make-instance 'lt:linearize-transformation
;;                                                                  :condition :instruction)))))

;; (defun test ()
;;   (exp:run-experiment
;;    `((:gogo ;; (exp:message :text "propogate")
;;             ;; (demo:demo :states ,(doeet "10-4*x,x=2" :equation))
;;             ;; (exp:message :text "easy, tree representation")
;;             ;;(demo:demo :states ,(doeet "(B-Cr)+F=29,F=B*Cr,B=5"))
;;             ;;(demo:demo :states ,(doeet "(A+B)-F=21,A=B*C,F=C*3,B=1+H,H=8"))
;;             (demo:demo :states ,(doeet "(2+(C+F))+5=14,F=C-((4+C)-(C+9)),C=(S+3)-7"))
;;             (exp:end)))
;;    :resizable t
;;    :width 1200
;;    :height 800
;;    :version (boxes.util:version)))
